Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/arrays/arrtest1.pas

Pascal/Delphi Source File | 1995-12-22 | 40.0 KB | 1,169 lines

{+------------------------------------------------------------
 | Unit ArrTest1
 |
 | Version: 1.0  Last modified: 06/14/95, 21:47:55
 | Author : P. Below
 | Project: Dynamic Arrays
 | Description:
 |   This Unit contains all the form and menu handling code of
 |   the array test program. The implementation Uses the other
 |   units ( arrtest2-arrtest8 ) that contain the divers & sundry
 |   dialogs that get called from several menu items.
 +------------------------------------------------------------}
unit Arrtest1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Menus, Arrays;

type
  TFixedStr = string[ 25 ];   { a custom data object  }
  PFixedStr = ^TFixedStr;
  TArrType = ( TA_Long, TA_Double, TA_Fixed, TA_String, TA_PChar );
    { this enumerated type is used to keep track of the current
      array we have in a TMainForm instance }

  TMainForm = class(TForm)
    (* all the stuff below is added by Delphi. HANDS OFF! *)
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    MnuFileExit: TMenuItem;
    Arrays1: TMenuItem;
    MnuUse: TMenuItem;
    MnuArraysRedim: TMenuItem;
    MnuArraysDestroy: TMenuItem;
    ArrayItems: TListBox;
    ArrayGroupbox: TGroupBox;
    ArrayProperties: TGroupBox;
    Label1: TLabel;
    ArrayType: TLabel;
    ArraySize: TLabel;
    Label2: TLabel;
    EditItems: TGroupBox;
    EdtItem: TEdit;
    BtnSet: TButton;
    BtnGet: TButton;
    BtnClose: TButton;
    BtnFill: TButton;
    Label3: TLabel;
    Label4: TLabel;
    EdtIndex: TEdit;
    BtnInsert: TButton;
    BtnDelete: TButton;
    N1: TMenuItem;
    MnuArraysSum: TMenuItem;
    MnuArraysFind: TMenuItem;
    MnuArraysSort: TMenuItem;
    MnuArraysClone: TMenuItem;
    N2: TMenuItem;
    MnuCopyItems: TMenuItem;
    N3: TMenuItem;
    MnuFileOpen: TMenuItem;
    MnuFileSaveAs: TMenuItem;
    N4: TMenuItem;
    MnuFileReadStream: TMenuItem;
    MnuFileWriteStream: TMenuItem;
    MnuTextfileRead: TMenuItem;
    MnuTextfileWrite: TMenuItem;
    N5: TMenuItem;
    MnuInspect: TMenuItem;
    MnuArrayEnlarge: TMenuItem;
    procedure MnuFileExitClick(Sender: TObject);
    procedure ArrayItemsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnSetClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BtnGetClick(Sender: TObject);
    procedure BtnInsertClick(Sender: TObject);
    procedure BtnDeleteClick(Sender: TObject);
    procedure BtnFillClick(Sender: TObject);
    procedure MnuArraysRedimClick(Sender: TObject);
    procedure MnuArraysFindClick(Sender: TObject);
    procedure MnuArraysSortClick(Sender: TObject);
    procedure MnuArraysSumClick(Sender: TObject);
    procedure Arrays1Click(Sender: TObject);
    procedure MnuUseClick(Sender: TObject);
    procedure MnuArraysCloneClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MnuCopyItemsClick(Sender: TObject);
    procedure MnuFileOpenClick(Sender: TObject);
    procedure MnuFileSaveAsClick(Sender: TObject);
    procedure MnuFileReadStreamClick(Sender: TObject);
    procedure MnuFileWriteStreamClick(Sender: TObject);
    procedure Datei1Click(Sender: TObject);
    procedure MnuTextfileReadClick(Sender: TObject);
    procedure MnuTextfileWriteClick(Sender: TObject);
    procedure MnuInspectClick(Sender: TObject);
    procedure MnuArrayEnlargeClick(Sender: TObject);
  private
    { the stuff below has been added by hand }
    FArray: T64KArray;       { the array, may be a derived class }
    FArrayType: TArrType;    { the current array type }
  public
    Procedure UpdateDisplay; { show array type and item count }
    Procedure FillListbox;   { fill listbox with array content }
    Function GetIndex( Var n: Cardinal ): Boolean;
                             { get array index from edit & check it }
  end;

var
  MainForm: TMainForm;

implementation

Uses ArrTest2, ArrTest3, ArrTest4, ArrTest5, ArrTest6, ArrTest7,
     ArrTest8;

{$R *.DFM}

Type
  TArrayTypenames = Array [ TArrType ] of TFixedStr;
Const
  (* the following constant is used to display the array type *)
  ArrayTypenames: TArrayTypenames = ( 'Long Integers',
                                      'Real Numbers (Double)',
                                      'Fixed-length Strings',
                                      'Any Pascal String',
                                      'Zero-term. Strings' );
{+------------------------------------------------------------------------
 | UpdateDisplay updates two statics on the main form to show the current
 | arrays type and size and also sets the limit on the edit field for
 | changing items.
 +-----------------------------------------------------------------------}
Procedure TMainForm.UpdateDisplay;
  Begin
    ArrayType.Caption := ArrayTypenames[ FArrayType ];
    ArraySize.Caption := IntToStr( FArray.MaxIndex+1 );
    Case FArrayType Of
      TA_Long: EdtItem.MaxLength := 12;
      TA_Double, TA_Fixed: EdtItem.MaxLength := 25;
      TA_String, TA_PChar: EdtItem.MaxLength := 255;
    End;
  End; { UpdateDisplay }

{+---------------------------------------------------------------------------
 | FillLIstbox fills the listbox with data from the current array, converted
 | to strings, if necessary. This may take some time for a large array, so
 | we put up the hourglass cursor.
 +--------------------------------------------------------------------------}
 Procedure TMainForm.FillListbox;
  Var
    i: Cardinal;
    p: Pointer;
  Begin
    Screen.Cursor := crHourGlass;
    ArrayItems.Perform( WM_SETREDRAW, 0, 0 );
    ArrayItems.Clear;
    Case FArrayType of
      TA_LONG:
        With FArray As TLongIntArray Do
          For i:= 0 To MaxIndex Do
            ArrayItems.Items.Add( IntToStr( Data[i] ));
      TA_DOUBLE:
        With FArray As TDoubleArray Do
          For i:= 0 To MaxIndex Do
            ArrayItems.Items.Add( FormatFloat( '0.00000',Data[i] ));
      TA_FIXED:
        For i:= 0 To FArray.MaxIndex Do
          ArrayItems.Items.Add( PFixedStr( FArray.GetItemPtr(i))^ );
      TA_STRING:
        With FArray As TPStringArray Do
          For i:= 0 To MaxIndex Do
            ArrayItems.Items.Add( Data[i] );
      TA_PChar:
        With FArray As TPCharArray Do
          For i:= 0 To MaxIndex Do
            ArrayItems.Items.Add( AsString[i] );
    End;
    ArrayItems.Perform( WM_SETREDRAW, 1, 0 );
    ArrayItems.Refresh;
    Screen.Cursor := crDefault;
  End; { FillListbox }

{+-------------------------------------------------------------------------
 | GetIndex obtains the contents of the index edit control and tries to
 | convert it into a number. If that fails it will use the current listbox
 | index or 0, if no item is selected.
 +------------------------------------------------------------------------}
 Function TMainForm.GetIndex( Var n: Cardinal ): Boolean;
  Begin
    Result := True;
    try
      n := StrToInt(EdtIndex.Text);
    except
      n := Cardinal(ArrayItems.ItemIndex);
      If n = Cardinal(-1) Then n:= 0;
    end;
  End;

{+=================================
 | Menu handlers for the main menu
 |   The File Menu
 +================================}

{+--------------------------------------------------------------------
 | This handler is called when the File menu is opened. It enables or
 | disables some items depending on array type.
 +-------------------------------------------------------------------}
procedure TMainForm.Datei1Click(Sender: TObject);
begin
  MnuTextfileRead.Enabled := FArrayType In [TA_STRING, TA_PCHAR];
  MnuTextfileWrite.Enabled := FArrayType In [TA_STRING, TA_PCHAR];
end;

{+------------------------------------------------------------------------
 | This handler is called from the File|Exit menu and also if Close is
 | selected from the system menu of a form. If the form is a clone of the
 | main form only the form will close ( and be released ), otherwise the
 | application will terminate.
 +-----------------------------------------------------------------------}
procedure TMainForm.MnuFileExitClick(Sender: TObject);
begin
  If Pos('Clone',Caption) = 1 Then
    Close
  Else
    Application.Terminate;
end;

{+----------------------------------------------------------------------------
 | This handler is called from the File|Open menu item. It puts up a standard
 | file open dialog, asking for an filename for a file to load. This has to
 | be a file created with File|Save As from an array of the same type, or
 | garbage will result! The file is loaded into the array, deleting any
 | previous contents. The display is updated.
 +---------------------------------------------------------------------------}
procedure TMainForm.MnuFileOpenClick(Sender: TObject);
Var
  OpenDlg: TOpenDialog;
begin
  OpenDlg := TOpenDialog.Create( Self );
  try
    With OpenDlg Do Begin
      DefaultExt := 'ARY';
      Filter := 'Array Files|*.ARY';
      Options := [ofFileMustExist, ofReadOnly, ofPathMustExist];
      Title := 'Open an Array File';
      If Execute Then Begin
        Screen.Cursor:= crHourglass;
        try
          Farray.LoadFromFile( Filename );
        finally
          UpdateDisplay;
          FillListbox;
          Screen.Cursor := crDefault;
        end;
      End;
    End;
  finally
    OpenDlg.Free
  end;
end;

{+-------------------------------------------------------------------------
 | This handler is called from the File|Save As menu item. It puts up a
 | standard file save dialog, asking for a filename for a file to write.
 | The file generated is a File of Componenttype for most of the array
 | types but not for String and PChar arrays. It can be read via the
 | File|Open menu.
 +------------------------------------------------------------------------}
procedure TMainForm.MnuFileSaveAsClick(Sender: TObject);
Var
  SaveDlg: TSaveDialog;
begin
  SaveDlg := TSaveDialog.Create( Self );
  try
    With SaveDlg Do Begin
      DefaultExt := 'ARY';
      Filter := 'Array Files|*.ARY';
      Options := [ofPathMustExist, ofHideReadOnly, ofOverwritePrompt];
      Title := 'Create an Array File';
      If Execute Then Begin
        Screen.Cursor:= crHourglass;
        try
          Farray.SaveToFile( Filename );
        finally
          Screen.Cursor:= crDefault
        end;
      End;
    End;
  finally
    SaveDlg.Free
  end;
end;

{+----------------------------------------------------------------------------
 | This handler is called from the File|Read Stream menu item. It puts up a
 | file open dialog, asking for an filename for a file to load. This has to
 | be a file created with File|Write Stream from an array of the same type, or
 | garbage will result! The file is loaded into the array, deleting any
 | previous contents. The display is updated.
 +---------------------------------------------------------------------------}
procedure TMainForm.MnuFileReadStreamClick(Sender: TObject);
Var
  OpenDlg: TOpenDialog;
  Stream : TFileStream;
begin
  OpenDlg := TOpenDialog.Create( Self );
  try
    With OpenDlg Do Begin
      DefaultExt := 'AST';
      Filter := 'Array Streams|*.AST';
      Options := [ofFileMustExist, ofReadOnly, ofPathMustExist];
      Title := 'Read an Array Stream';
      If Execute Then Begin
        Stream:= TFileStream.Create( Filename, fmOpenRead or fmShareDenyWrite );
        Screen.Cursor:= crHourglass;
        try
          Farray.LoadFromStream( Stream );
        finally
          Stream.Free;
          UpdateDisplay;
          FillListbox;
          Screen.Cursor:= crDefault;
        end;
      End;
    End;
  finally
    OpenDlg.Free
  end;
end;

{+-------------------------------------------------------------------------
 | This handler is called from the File|Write Stream menu item. It puts up a
 | standard file save dialog, asking for a filename for a file to write.
 | The file generated is contains a small header in addition to the array
 | data, so is not compatible with the format produced by File|Save As,
 | unless the array is an array of strings or pchars. For the latter two
 | the file I/O calls the stream I/O methods to make life simpler for the
 | weary programmer.
 +------------------------------------------------------------------------}
procedure TMainForm.MnuFileWriteStreamClick(Sender: TObject);
Var
  SaveDlg: TSaveDialog;
  Stream : TFileStream;
begin
  SaveDlg := TSaveDialog.Create( Self );
  try
    With SaveDlg Do Begin
      DefaultExt := 'AST';
      Filter := 'Array Streams|*.AST';
      Options := [ofPathMustExist, ofHideReadOnly, ofOverwritePrompt];
      Title := 'Write an Array Stream';
      If Execute Then Begin
        Stream:= TFileStream.Create( Filename, fmCreate );
        try
          Screen.Cursor := crHourGlass;
          Farray.SaveToStream( Stream );
        finally
          Screen.Cursor:= crDefault;
          Stream.Free
        end;
      End;
    End;
  finally
    SaveDlg.Free
  end;
end;

{+-------------------------------------------------------------------------
 | This handler is called from the File|Read Textfile menu item, which is
 | only accessible for String and PChar arrays. The methods puts up a standard
 | file open dialog, asking for an filename for a file to load. This can be
 | any normal text file, with lines terminated by CR/LF combinations. The
 | array has a limit of 16K lines, anything longer will produce an error
 | which is handled gracefully. While the file loads a progress dialog is
 | displayed that allows the process to be aborted.
 +------------------------------------------------------------------------}
procedure TMainForm.MnuTextfileReadClick(Sender: TObject);
Var
  OpenDlg: TOpenDialog;
  appendData: Boolean;
  ProgressDlg: TProgressDlg;
begin
  OpenDlg := TOpenDialog.Create( Self );
  try
    With OpenDlg Do Begin
      DefaultExt := 'TXT';
      Filter := 'Textfiles|*.TXT';
      Options := [ofFileMustExist, ofReadOnly, ofPathMustExist];
      Title := 'Read a Textfile';
      If Execute Then Begin
        appendData :=
          MessageDlg('Do you want to append the files text to the array?',
                     mtConfirmation, [mbYes, mbNo], 0) = mrYes;
        ProgressDlg:= TProgressDlg.Create(Self);
        try
          ProgressDlg.Gauge.Value := 0;
          ProgressDlg.LblFilename.Caption := Filename;
          ProgressDlg.LblAction.Caption   := 'Reading file';
          ProgressDlg.Show;
          Case FArrayType Of
            TA_STRING:
              TPStringArray( FArray).LoadFromTextfile( Filename, appendData,
                        ProgressDlg.ReportProgressOnLoad );
            TA_PCHAR:
              TPCharArray( FArray).LoadFromTextfile( Filename, appendData,
                        ProgressDlg.ReportProgressOnLoad );
          End;
        finally
          ProgressDlg.Close;
          UpdateDisplay;
          FillListbox;
        end;
      End;
    End;
  finally
    OpenDlg.Free
  end;
end;

{+-------------------------------------------------------------------------
 | This handler is called from the File|Write Textfile menu item, which is
 | only accessible for String and PChar arrays. The methods puts up a standard
 | file save dialog, asking for an filename for a file to load. The file
 | produced is a normal text file, with lines terminated by CR/LF combinations.
 | While the file is written a progress dialog is displayed that allows the
 | process to be aborted.
 +------------------------------------------------------------------------}
procedure TMainForm.MnuTextfileWriteClick(Sender: TObject);
Var
  SaveDlg: TSaveDialog;
  appendData: Boolean;
  ProgressDlg: TProgressDlg;
begin
  SaveDlg := TSaveDialog.Create( Self );
  try
    With SaveDlg Do Begin
      DefaultExt := 'TXT';
      Filter := 'Textfiles|*.TXT';
      Title := 'Read a Textfile';
      Options := [ofPathMustExist, ofHideReadOnly];
      If Execute Then Begin
        If FileExists( Filename ) Then
          appendData :=
            MessageDlg('Do you want to append the array text to the file?',
                       mtConfirmation, [mbYes, mbNo], 0) = mrYes
        Else
          appendData := False;
        ProgressDlg:= TProgressDlg.Create(Self);
        try
          ProgressDlg.Gauge.Value := 0;
          ProgressDlg.LblFilename.Caption := Filename;
          ProgressDlg.LblAction.Caption   := 'Writing file';
          ProgressDlg.Show;
          Case FArrayType Of
            TA_STRING:
              TPStringArray( FArray).SaveToTextfile( Filename, appendData,
                        ProgressDlg.ReportProgressOnStore );
            TA_PCHAR:
              TPCharArray( FArray).SaveToTextfile( Filename, appendData,
                        ProgressDlg.ReportProgressOnStore );
          End;
        finally
          ProgressDlg.Close;
        end;
      End;
    End;
  finally
    SaveDlg.Free
  end;
end;

{+=================================
 | Menu handlers for the main menu
 |   The Arrays Menu
 +================================}

{+--------------------------------------------------------------------
 | This handler is called when the Arrays menu is opened. It sets the
 | enabled/disbaled states for a few menu items that are dependent on
 | the arrays type.
 +-------------------------------------------------------------------}
procedure TMainForm.Arrays1Click(Sender: TObject);
begin
  MnuArraysSum.Enabled := FArrayType In [TA_LONG, TA_DOUBLE];
  MnuArraysSort.Enabled := FArray.HasFlag( AF_CanCompare );
  MnuArraysFind.Enabled := FArray.HasFlag( AF_CanCompare );
  MnuArrayEnlarge.Enabled := FArrayType In [TA_String, TA_PChar];
end;

{+---------------------------------------------------------------------------
 | This handler is called when the Arrays|Use menu item is clicked. It
 | displays a selection of the available array types and creates an new
 | array of the requested type, deleting the old one. All arrays start
 | with a default size and empty items.
 +--------------------------------------------------------------------------}
procedure TMainForm.MnuUseClick(Sender: TObject);
Var
  typesDlg: TTypesDlg;
begin
  typesDlg := TTypesDlg.Create( Self );
  typesDlg.GrpArrayStyles.ItemIndex := Ord(FArrayType);
  try
    If typesDlg.ShowModal = mrOK Then
      If typesDlg.GrpArrayStyles.ItemIndex <> Ord(FArrayType) Then Begin
        FArray.Free;
        Case typesDlg.GrpArrayStyles.ItemIndex Of
          0: Begin
               FArray := TLongIntArray.Create(20,0);
               FArrayType := TA_LONG;
             End;
          1: Begin
               FArray := TDoubleArray.Create(20,0);
               FArrayType := TA_DOUBLE;
             End;
          2: Begin
               FArray := T64KArray.Create(20,Sizeof( TFixedStr));
               FArrayType := TA_FIXED;
             End;
          3: Begin
               FArray := TPStringArray.Create(20,0);
               FArrayType := TA_STRING;
             End;
          4: Begin
               FArray := TPCharArray.Create(20,0);
               FArrayType := TA_PCHAR;
             End;
        End;
        UpdateDisplay;
        FillListbox;
        ArrayItems.ItemIndex := 0;
      End;
  finally
    sortDlg.Free
  end;
end;

{+---------------------------------------------------------------------------
 | This handler is called when the Arrays|Redim menu item is clicked. It
 | displays an input dialog to ask the user for the new size of the array
 | he wants and, if the dialog was not canceled and the input it a valid
 | number, resize the arrays and refresh the display to reflect the changes.
 +--------------------------------------------------------------------------}
procedure TMainForm.MnuArraysRedimClick(Sender: TObject);
Var
  n: Cardinal;
  inputDialog: TInputDialog;
begin
  inputDialog := TInputDialog.Create( Self );
  try
    With InputDialog Do Begin
      Caption := 'Redim Array';
      Prompt.Caption := 'Enter the number of items you want';
      EdtInput.Text := '';
      EdtInput.MaxLength := 5;
      If ShowModal = mrOk Then Begin
        try
          n := StrToInt( EdtInput.Text );
          FArray.Redim( n );
        except
          on EConvertError Do
            ShowMessage('Your input was not a valid integer number!');
        end;
      End;
    End;
  finally
    inputdialog.Free;
    UpdateDisplay;
    FillListbox;
    ArrayItems.ItemIndex := 0;
  end;
end;

{+----------------------------------------------------------------------------
 | This handler is called from the Arrays|Find menu item. It puts up a dialog
 | asking the user for an item to search for (it has to be of the same type
 | as the arrays), and, if the dialog was not canceled and the data looks
 | ok, tries to search for the item and displays the index of the found entry,
 | or an error message.
 | Note that we do not check whether the current array has the ability to
 | search for items. That is not necessary because the menu item will be
 | disabled if the array cannot compare items!
 +---------------------------------------------------------------------------}
 procedure TMainForm.MnuArraysFindClick(Sender: TObject);
Var
  n: Cardinal;
  l : LongInt;
  f : Double;
  s : TFixedStr;
  pCh: PChar;
  str: PString;
  inputDialog: TInputDialog;
begin
  inputDialog := TInputDialog.Create( Self );
  try
    With InputDialog Do Begin
      Caption := 'Find Item';
      Prompt.Caption := 'Enter the value to search for';
      EdtInput.Text := '';
      EdtInput.MaxLength := 20;
      n := NOT_FOUND;
      If ShowModal = mrOk Then Begin
        try
          Case FArrayType Of
            TA_LONG: Begin
                l := StrToInt(EdtInput.Text );
                n := FArray.Find( l );
              End;
            TA_Double: Begin
                f := StrToFloat(EdtInput.Text );
                n := FArray.Find( f );
              End;
            TA_FIXED: Begin
                s := EdtInput.Text;
                n := FArray.Find( s );
              End;
            TA_STRING: Begin
                str := NewStr( EdtInput.Text );
                try
                  n := FArray.Find( str );
                finally
                  DisposeStr( str );
                end;
              End;
            TA_PCHAR: Begin
                pCh := StrAlloc( EdtItem.GetTextLen + 1 );
                try
                 EdtItem.GetTextBuf( pCh, StrBufSize( pCh ));
                 n := FArray.Find( pCh );
                finally
                  StrDispose( pCh );
                end;
              End;
          End;
          If n = NOT_FOUND Then
            ShowMessage('The value was not found!')
          Else Begin
            ShowMessage(Format('The value was found at index %u.',
                        [n]));
            ArrayItems.ItemIndex := n;
          End;
        except
          on EConvertError Do
            ShowMessage('Your input was not a valid value for the array current type!');
        end;
      End;
    End;
  finally
    inputdialog.Free;
  end;
end;

{+----------------------------------------------------------------------------
 | This handler is called from the Arrays|Sort menu item. It puts up a dialog
 | that allows a choice of ascending or descending search and then sorts the
 | array according to the users selection. Finally the display is updated.
 +---------------------------------------------------------------------------}
 procedure TMainForm.MnuArraysSortClick(Sender: TObject);
Var
  sortDlg: TSortDlg;
  ascending: Boolean;
begin
  sortDlg := TSortDlg.Create( Self );
  try
    If sortDlg.ShowModal = mrOK Then Begin
      ascending := sortdlg.GrpSortOrder.ItemIndex = 0;
      FArray.Sort( ascending );
    End;
  finally
    sortDlg.Free;
    FillListbox;
    ArrayItems.ItemIndex := 0;
  end;
end;

(* The following tiny object is used by the MnuArraysSumClick method
   to add up the numbers in a numeric array by using the ForEach iterator.
   Using a temporary object makes the use of a local procedure ( like for
   Borland Pascal Collections ) unnecessary. *)
Type
  TSumObj = class
    public
    sumf: Double;
    suml: LongInt;

    Procedure AddLongs( VAR Item; index: cardinal );
    Procedure AddFloats(VAR Item; index: cardinal );
  end;
procedure TSumObj.AddLongs;
Var
  Long: LongInt absolute Item;
Begin
  suml := suml + Long;
end;
procedure TSumObj.AddFloats;
Var
  Dbl: Double absolute Item;
Begin
  sumf := sumf + Dbl;
end;

{+----------------------------------------------------------------------------
 | This handler is called from the Arrays|Sum menu item. This item will only
 | be enabled if the array is an array of numbers. The handler creates a
 | local object instance of TSumObj and uses one of the methods of TSumObj
 | as an iterator in the call to ForEach. The result is displayed in a
 | message.
 +---------------------------------------------------------------------------}
procedure TMainForm.MnuArraysSumClick(Sender: TObject);
Var
  sumobj: TSumObj;
begin
  If FArrayType In [TA_LONG, TA_DOUBLE] Then Begin
    sumObj := TSumObj.Create;
    try
      If FArrayType = TA_LONG Then
        FArray.ForEach( sumObj.AddLongs, false, 1 )
      Else
        FArray.ForEach( sumObj.AddFloats, false, 1 );
      ShowMessage( Format(
          'Sum over Longs : %d'+#13#10+
          'Sum over Floats: %12.6f', [sumObj.suml, sumObj.sumf]));
    finally
      sumObj.Free;
    end;
  End;
end;

{+---------------------------------------------------------------------------
 | This handler is called when the Arrays|Use menu item is selected. It pops
 | up a dialog presenting the available array classes. If the user makes a
 | selection of a different type than the current array type, the current
 | array gets deleted and a new one of the reqested type is created. The
 | display is finally updated. All arrays start of with 20 empty ( =0 )
 | entries.
 +--------------------------------------------------------------------------}
procedure TMainForm.MnuArraysCloneClick(Sender: TObject);
Const
  newtag: Integer = 0;
Var
  NewForm: TMainForm;
  i: cardinal;
  n: Integer;
begin
  Screen.Cursor := crHourGlass;
  try
    Application.CreateForm( TMainForm, NewForm );
    Inc(newtag);
    With NewForm Do Begin
      try
        FArray.Free;
        FArray := Self.FArray.Clone;
        FArrayType := Self.FArrayType;
        UpdateDisplay;
        FillListbox;
        Caption := 'Clone'+IntToStr(newtag);
        Name := Caption;
        Tag := newtag;
        Position := poDefault;
        Show;
      except
        Close;
        raise
      end;
    End;
  finally
    Screen.Cursor := crDefault;;
  end;
end;

{+---------------------------------------------------------------------
 | This handler is called when the Arrays|Copy menu item is selected.
 | It presents a dialog with two listboxes and a few fields. The listboxes
 | both show all the currently open instances of the main window by title.
 | The user can select a source and a target for a copy operation ( both
 | may be the same ), source and target index and the number of
 | items to copy. If the dialog is not canceled the items are then copied
 | from source to target and the display is refreshed.
 +--------------------------------------------------------------------}
 procedure TMainForm.MnuCopyItemsClick(Sender: TObject);
Var
  CopyDlg: TCopyDlg;
  i: Cardinal;
  iTo, iFrom, iCount: Integer;
  source, target: TMainForm;
begin
  CopyDlg := TCopyDlg.Create( Self );
  try
    CopyDlg.LstSource.Clear;
    CopyDlg.LstTarget.Clear;
    For i:= 0 To Application.ComponentCount-1 Do
      If Application.Components[i] Is TMainForm Then
      With Application.Components[i] Do Begin
        CopyDlg.LstSource.Items.Add( Name );
        CopyDlg.LstTarget.Items.Add( Name );
      End;
    With CopyDlg Do Begin
      LstSource.ItemIndex:= 0;
      LstTarget.ItemIndex:= 0;
      EdtFromIndex.Text := '0';
      EdtToIndex.Text := '0';
      EdtNumItems.Text := '0';
      If ShowModal = mrOK Then Begin
        try
          iFrom := StrToInt( EdtFromIndex.Text );
          iTo   := StrToInt( EdtToIndex.Text );
          iCount := StrToInt( EdtNumItems.Text );
        except
          on E:EConvertError Do Begin
            iFrom := 0;
            iTo   := 0;
            iCount:= 0;
            ShowException( E, ErrorAddr );
          End
        End;
        If (iCount > 0) and
           (LstSource.ItemIndex >= 0) and
           (LstTarget.ItemIndex >= 0)
        Then Begin
                    Screen.Cursor := crHourGlass;
          Source := Application.FindComponent(
                      LstSource.Items[LstSource.ItemIndex] )
                    As TMainForm;
          Target := Application.FindComponent(
                      LstTarget.Items[LstTarget.ItemIndex] )
                    As TMainForm;
          try
            Target.FArray.BlockCopy( Source.FArray, iFrom, iTo, iCount );
          finally
            Target.FillListbox;
            Screen.Cursor := crDefault;
          end;
        End;
      End;
    End;
  finally
    CopyDlg.Free;
  end;
end;

{+---------------------------------------------------------------------------
 | This handler is called from the Arrays|Inspect menu item. It will display
 | a dialog that shows the state of all the 16 array flags. Only the
 | AF_AutoSize flag can be changed in this dialog. It determines whether
 | the array will automatically resize when items are inserted and deleted.
 | Each flag corresponds to a checkbox on this dialog and the checkboxes
 | have Tag values that correspond to the ordinal value of the flags.
 +--------------------------------------------------------------------------}
procedure TMainForm.MnuInspectClick(Sender: TObject);
Var
  inpDlg: TInspectionDlg;
  f : TArrayFlags;
  n : Cardinal;
begin
  inpDlg := TInspectionDlg.Create(Self);
  try
    For f:= Low(TarrayFlags) To High(TArrayFlags) Do
      If Farray.HasFlag( f ) Then
      With inpDlg.GrpFlags Do Begin
        For n:= 0 To ControlCount Do
          With Controls[n] As TCheckbox Do
            If Tag = Ord(f) Then Begin
              Checked := True;
              Break
            End;
      End;
    inpDlg.ShowModal;
    If inpDlg.ChkAutoSize.Checked Then
      Farray.SetFlag( AF_AutoSize )
    Else
      Farray.ClearFlag( AF_AutoSize );
  finally
    inpDlg.Free;
  end;
end;

{+------------------------------------------------------------------------
 | This handler is called from the Arrays|Enlarge menu item. This item is
 | only selectable for string an pchar arrays. It pops up a resizeable
 | dialog with a wide listbox and a close button. The listbox shows the
 | arrays contents like the one on the main form, but it will show longer
 | lines of text in their full glory. The dialog is nonmodal, so you can
 | conceivably open several for one main form. Is hard on the resources,
 | though!
 +-----------------------------------------------------------------------}
procedure TMainForm.MnuArrayEnlargeClick(Sender: TObject);
Var
  n: Cardinal;
begin
  With TEnlargedViewDlg.Create(Self) Do Begin
    Screen.Cursor:= crHourGlass;
    try
      try
        For n:= 0 To ArrayItems.Items.Count-1 Do
          LstView.Items.Add( ArrayItems.Items[n] );
        Show;
      finally
        Screen.Cursor := crDefault;
      end
    except
      Free
    end;
  End;
end;

{+=====================
 | Form event handlers
 +====================}

{+---------------------------------------------------------------------------
 | This handler is called when a form is created. It creates a default array
 | of integers and displays it.
 +--------------------------------------------------------------------------}
procedure TMainForm.FormCreate(Sender: TObject);
begin
  FArray := TLongIntArray.Create(20,0);
  FArrayType := TA_LONG;
  UpdateDisplay;
  FillListbox;
end;

{+----------------------------------------------------------------------
 | This handler is called when the form is destroyed. It frees the array.
 +---------------------------------------------------------------------}
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FArray.Free;
end;

{+---------------------------------------------------------------------------
 | This handler is called when the form is about to close. We tell Delphi to
 | actually destroy the form, not only hide it.
 +--------------------------------------------------------------------------}
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

{+========================
 | Control event handlers
 |   Listbox events
 +=======================}

{+---------------------------------------------------------------------
 | This handler is called when the user clicks on a listbox item or if
 | the item is selected by program. The method puts the selected items
 | index and content into two edit controls on the form.
 +--------------------------------------------------------------------}
procedure TMainForm.ArrayItemsClick(Sender: TObject);
begin
  If ArrayItems.ItemIndex >= 0 Then Begin
    EdtIndex.Text := IntToStr( ArrayItems.ItemIndex );
    EdtItem.Text := ArrayItems.Items[ ArrayItems.ItemIndex ];
  End
  Else Begin
    EdtIndex.Text := '';
    EdtItem.Text := '';
  End;
end;

{+========================
 | Control event handlers
 |   Button events
 +=======================}

{+---------------------------------------------------------------------------
 | This handler is called when the Set button is clicked. It tries to obtain
 | the contents of the edit controls ( an index and a value for an item ) an
 | overwrites the array item at the selected index with the value from the
 | edit. The changes are reflected in the listbox.
 +--------------------------------------------------------------------------}
procedure TMainForm.BtnSetClick(Sender: TObject);
Var
  n: Cardinal;
  f: Double;
  s: TFixedStr;
begin
  If not GetIndex(n) Then Exit;
  { we do no check the index on purpose to show how the array
    objects raises exceptions on index range errors }
  Case FarrayType of
    TA_LONG: Begin
        try
          (FArray As TLongIntArray)[n] := StrToInt( EdtItem.Text );
        except
          On EConvertError Do Begin
            ShowMessage( 'The entered string is not a valid integer!');
            Exit;
          End;
        End;
      End;
    TA_DOUBLE: Begin
        try
          (FArray As TDoubleArray)[n] := StrToFloat( EdtItem.Text );
        except
          On EConvertError Do Begin
            ShowMessage( 'The entered string is not a valid real number!');
            Exit;
          End;
        End;
      End;
    TA_FIXED: Begin
        s := EdtItem.Text;
        FArray.PutItem( n, s );
      End;
    TA_STRING: (FArray As TPStringArray)[n] := EdtItem.Text;
    TA_PCHAR : (FArray As TPCharArray).AsString[n] := EdtItem.Text;
  End;
  FillListbox;
  ArrayItems.ItemIndex := n;
end;

{+----------------------------------------------------------------------------
 | This handler is called by a click on the Get button. This button retrieves
 | an index value from the index edit and copies the requested array item
 | to the value edit field. The item is selected in the listbox.
 +---------------------------------------------------------------------------}
procedure TMainForm.BtnGetClick(Sender: TObject);
Var
  n: Cardinal;
begin
  If not GetIndex(n) Then Exit;
  EdtItem.Text := ArrayItems.Items[n];
  ArrayItems.ItemIndex := n;
end;


{+----------------------------------------------------------------------------
 | This handler is called by a click on the Insert button. This button
 | retrieves an index value from the index edit and a value form the value
 | edit field and inserts the value into the array at the requested position.
 | This will cause the array to grow if its AutoSize flag is set, otherwise
 | the last entry will fall off into The Great Bit Bucket Beyond.
 +---------------------------------------------------------------------------}
procedure TMainForm.BtnInsertClick(Sender: TObject);
Var
  n: Cardinal;
  f: Double;
  l: LongInt;
  s: TFixedStr;
  str: PString;
  pCh: PChar;
begin
  If not GetIndex(n) Then Exit;
  try
  Case FarrayType of
    TA_LONG: Begin
        try
          l := StrToInt( EdtItem.Text );
          FArray.Insert(l, n, 1);
        except
          On EConvertError Do Begin
            ShowMessage( 'The entered string is not a valid integer!');
            Exit;
          End;
        End;
      End;
    TA_DOUBLE: Begin
        try
          f := StrToFloat( EdtItem.Text );
          FArray.Insert(f, n, 1);
        except
          On EConvertError Do Begin
            ShowMessage( 'The entered string is not a valid real number!');
            Exit;
          End;
        End;
      End;
    TA_FIXED: Begin
        s := EdtItem.Text;
        FArray.Insert( s, n, 1 );
      End;
    TA_STRING: Begin
        New( str );
        try
         str^ := EdtItem.Text;
         FArray.Insert( str, n, 1 );
        finally
          Dispose( str );
        end;
      End;
    TA_PCHAR: Begin
        pCh := StrAlloc( EdtItem.GetTextLen + 1 );
        try
         EdtItem.GetTextBuf( pCh, StrBufSize( pCh ));
         FArray.Insert( pCh, n, 1 );
        finally
          StrDispose( pCh );
        end;
      End;
  End;
  finally
    UpdateDisplay;
    FillListbox;
    ArrayItems.ItemIndex := n;
  end;
end;

{+----------------------------------------------------------------------------
 | This handler is called by a click on the Delete button. This button
 | retrieves an index value from the index edit and deletes the item
 | at the requested position from the array .
 | This will cause the array to shrink if its AutoSize flag is set, otherwise
 | the last entry will be set to 0.
 +---------------------------------------------------------------------------}
procedure TMainForm.BtnDeleteClick(Sender: TObject);
Var
  n: Cardinal;
begin
  If GetIndex(n) Then Begin
    try
      FArray.Delete(n, 1);
    finally
      FillListbox;
      UpdateDisplay;
      ArrayItems.ItemIndex := n;
    end;
  End;
end;

{+----------------------------------------------------------------------------
 | This handler is called by a click on the Fill button. This causes the
 | array to be filled with default values, depending on the array type.
 +---------------------------------------------------------------------------}
procedure TMainForm.BtnFillClick(Sender: TObject);
Var
  n: Cardinal;
  s: TFixedStr;
  pCh: PChar;
  l: LongInt;
begin
  Case FArrayType Of
    TA_LONG:
      For n:= 0 To FArray.MaxIndex Do
        TLongIntArray(FArray)[n] := Random( 500 );
    TA_DOUBLE:
      For n:= 0 To FArray.MaxIndex Do
        TDoubleArray(FArray)[n] := Sqrt( Round(Random(10000)));
    TA_FIXED:
      For n:= 0 To FArray.MaxIndex Do Begin
        s := Format('<%.8d>',[n]);
        FArray.PutItem( n, s );
      End;
    TA_STRING:
      For n:= 0 To FArray.MaxIndex Do
        TPStringArray(FArray)[n] :=
           Format('This is Line number %d!',[n]);
    TA_PCHAR: Begin
        pCh := StrAlloc( 100 );
        try
          For n:= 0 To FArray.MaxIndex Do Begin
            l := n;
            wvsprintf( pCh, 'This is Line number %#lX!', l );
            TPCharArray(FArray)[n] := pCh;
          End;
        finally
          StrDispose( pCh );
        end;
      End;
  End; { Case }
  FillListbox;
  ArrayItems.ItemIndex:= 0;
end;

begin
  Randomize;
end.